perm filename DV.FIX[MF,ALS] blob
sn#795705 filedate 1985-06-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 @p function read_ascii(p:integer):real
C00009 00003 @ @<Read ASCII number and express as a real value@>=
C00011 00004 function read_ascii(o:eight_bitsp,k:integer):real
C00013 00005 @p function read_ascii(p:integer):real
C00022 ENDMK
C⊗;
@p function read_ascii(p:integer):real;
var jj,kk:real;
negative:boolean;
begin
jj←0.0;
negative←false;
while (xxx_o=" ") and (xxx_k<p) do begin incr(xxx_k); xxx_o←get_byte; end;
if (xxx_o="-") and (xxx_k<p) then begin negative←true;
incr(xxx_k); xxx_o←get_byte;
end;
while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k≤p) do begin
jj←jj*10+(xxx_o-"0"); incr(xxx_k); if xxx_k<p then xxx_o←get_byte;
end;
if (xxx_o=".") and (xxx_k≤p) then
begin
incr(xxx_k); if xxx_k<p then xxx_o←get_byte;
kk←1.0;
while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k≤p) do
begin
kk←kk*0.1; jj←jj+kk*(xxx_o-"0"); incr(xxx_k);
if xxx_k<p then xxx_o←get_byte;
end;
end;
if negative then jj←-jj;
read_ascii←jj;
end;
from dvidov.sai
case xcommand[1 for 1] of
begin
["p"] comment remember current position;
if equ(xcommand,"point") then
begin integer pindex;
rejectextension←FALSE;
pindex←intscan(xcommandline,brchar);
hcoord[pindex]←hh;
vcoord[pindex]←vv;
DEBUGONLY if (DEBUG land dvicommands) then
print("[index=",pindex,
" hh=",hh*pixtoprint,
" vv=",vv*pixtoprint,"]");
end;
["m"] comment Move current position to point position;
if equ(xcommand,"moveto") then
begin integer pindex;
rejectextension←FALSE;
if not nomwarn then
warn(""""&"moveto"&""""&
" commands are not standard TeX extensions");
nomwarn←true;
pindex←intscan(xcommandline,brchar);
h ← (hh←hcoord[pindex])/pconv + .5;
v ← (vv←vcoord[pindex])/pconv + .5;
end;
["j"] comment join points;
if equ(xcommand,"join") then
begin integer vecfont,p1,p2;
rejectextension←FALSE;
vecfont←choosevecfont(realscan(xcommandline,brchar));
p2←intscan(xcommandline,brchar);
while scan(xcommandline,skipspaces,brchar) do
begin
p1←p2;
p2←intscan(xcommandline,brchar);
DEBUGONLY if (DEBUG land dvicommands) then
print("[p1=",p1," p2=",p2,"]");
outvector(hcoord[p1],vcoord[p1],hcoord[p2],vcoord[p2],vecfont);
end;
end;
["r"]
if equ(xcommand,"rectangle") then
begin integer p1,p2,lx,by,w,h,txre,pmod;
rejectextension←FALSE;
txre←intscan(xcommandline,brchar);
scan(xcommandline,skipspaces,brchar);
pmod←scan(xcommandline,oneword,brchar);
if (pmod neq "o") then
warn("Replacing ""o"" for "&pmod
&" in: rectangle "
&cvs(txre)&" "&pmod&xcommandline);
p1←intscan(xcommandline,brchar);
p2←intscan(xcommandline,brchar);
lx←hcoord[p1];
by←vcoord[p1];
w←hcoord[p2]-lx;
h←by-vcoord[p2] # remember y grows downwards;
if w<0 then
begin
w←-w;
lx←lx-w;
end;
if h<0 then
begin
h←-h;
by←by+h;
end;
DEBUGONLY if (DEBUG land dvicommands) then
print("[p1=",p1," p2=",p2,"]");
outrect(lx,by,w,h,txre,pmod);
end;
else begin end
end;
see oc.web page 9 line 73
@ @<Read ASCII number and express as a real value@>=
begin
jj←0.0;
negative←false;
while (o=" ") and (k<p) do begin incr(k); o←get_byte; end;
if (o="-") and (k<p) then begin negative←true; incr(k); o←get_byte; end;
while (o≥"0") and (o≤"9") and (k<p) do begin
jj←jj*10+(o-"0"); incr(k); o←get_byte;
@!debug
print(xchr[o]);
gubed
end;
if (o=".") and (k<p) then
begin incr(k); o←get_byte;
@!debug
print(xchr[o]);
gubed
kk←1.0;
while (o≥"0") and (o≤"9") and (k<p) do
begin kk←kk*0.1;
jj←jj+kk*(o-"0");
incr(k); o←get_byte;
@!debug
print(xchr[o]);
gubed
end;
if negative then jj←-jj;
end;
end
function read_ascii(o:eight_bits;p,k:integer):real;
var jj,kk:real;
negative:boolean;
begin
jj←0.0;
negative←false;
while (o=" ") and (k<p) do begin incr(k); o←get_byte; end;
if (o="-") and (k<p) then begin negative←true; incr(k); o←get_byte; end;
while (o≥"0") and (o≤"9") and (k<p) do begin
jj←jj*10+(o-"0"); incr(k); o←get_byte;
@!debug
print(xchr[o]);
gubed
end else jj←0.0;
if (o=".") and (k<p) then
begin incr(k); o←get_byte;
@!debug
print(xchr[o]);
gubed
kk←1.0;
while (o≥"0") and (o≤"9") and (k<p) do
begin kk←kk*0.1; jj←jj+kk*(o-"0"); incr(k); o←get_byte;
@!debug
print(xchr[o]);
gubed
end;
if negative then jj←-jj;
end;
cur_o_val←o; cur_k_val←k;
read_ascii←jj;
end
@p function read_ascii(p:integer):real;
var jj,kk:real;
negative:boolean;
begin
jj←0.0;
negative←false;
while (xxx_o=" ") and (xxx_k<p) do begin incr(xxx_k); xxx_o←get_byte; end;
if (xxx_o="-") and (xxx_k<p) then begin negative←true; incr(xxx_k); xxx_o←get_byte; end;
while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k<p) do begin
jj←jj*10+(xxx_o-"0"); incr(xxx_k); xxx_o←get_byte;
@!debug
print(xchr[xxx_o]);
gubed
end;
if (xxx_o=".") and (xxx_k<p) then
begin incr(xxx_k); xxx_o←get_byte;
@!debug
print(xchr[xxx_o]);
gubed
kk←1.0;
while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k<p) do
begin kk←kk*0.1; jj←jj+kk*(xxx_o-"0"); incr(xxx_k); xxx_o←get_byte;
@!debug
print(xchr[xxx_o]);
gubed
end;
if negative then jj←-jj;
end;
read_ascii←jj;
end;
@#
procedure do_point(p:integer);
var k:integer; {loop variable}
o:eight_bits;
match:boolean; {does everything match}
begin if p<7 then for k←2 to p do o←get_byte else
begin match←true;
for k←2 to 6 do
begin o←get_byte;
if o≠xxx_point[k] then match←false;
@!debug
print(xchr[o]);
gubed
end;
p_index←0;
for k←7 to p do
begin o←get_byte;
if match then p_index←p_index*10+o-"0";
end;
if match then
begin hh_point[p_index]←pixel_round(h);
vv_point[p_index]←pixel_round(v);
@!debug
print(p_index:1,' ',pixel_round(h):1,',',pixel_round(v):1);
gubed
end;
end;
end;
@#
procedure do_join(p:integer);
var k,q,r:integer;
pen_real:real; {the pen size as read}
jj,kk:real; {used in computing |pen_size|}
match:boolean; {does everything match}
begin if p<8 then for k←2 to p do xxx_o←get_byte else
begin match←true;
for k←2 to 5 do
begin xxx_o←get_byte;
if xxx_o≠xxx_join[k] then match←false;
@!debug
print(xchr[xxx_o]);
gubed
end;
if not match then for k←6 to p do xxx_o←get_byte else
begin xxx_o←get_byte;
@!debug
print(xchr[xxx_o]);
gubed
xxx_k←k;
jj←read_ascii(p);
pen_size←pixel_round(jj*65536.0);
if pen_size>20 then pen_size←20 else if pen_size<0 then pen_size←0;
im_byte(set_pen); im_byte(pen_size);
@!debug
print('(',pen_size:1,')');
gubed
vertex_count←1; q←0; incr(xxx_k);
for k←xxx_k to p do begin
xxx_o←get_byte;
if (xxx_o≥"0") and (xxx_o≤"9") then q←q*10+xxx_o-"0" else
if xxx_o=" " then begin
@!debug
print(' ',q:1);
gubed
join_points[vertex_count]←q; incr(vertex_count); q←0;
end;
end;
join_points[vertex_count]←q;
@!debug
print(' ',q:1);
print(' [',im_byte_no:1,'] create_path ');
gubed
im_byte(create_path);
im_halfword(vertex_count);
@!debug
print(' (',vertex_count:1,')');
gubed
for q←1 to vertex_count do
begin im_halfword(hh_point[join_points[q]]);
im_halfword(vv_point[join_points[q]]);
@!debug
print(' ',hh_point[join_points[q]]:1);
print(',',vv_point[join_points[q]]:1);
gubed
end;
@!debug
print(' [',im_byte_no:1,'] draw_path ');
gubed
im_byte(draw_path); im_byte(15);
end;
end;
end;
@#
procedure do_circle(p:integer);
var k,q,r:integer; jj,kk:real;
negative:boolean; {is it a negative number?}
match:boolean; {does everything match}
begin if p<13 then for k←2 to p do xxx_o←get_byte else
begin match←true;
for k←2 to 7 do
begin xxx_o←get_byte;
if xxx_o≠xxx_circle[k] then match←false;
@!debug
gubed
print(xchr[xxx_o]);
end;
if not match then for k←8 to p do xxx_o←get_byte else
begin xxx_o←get_byte;
@!debug
gubed
print(xchr[xxx_o]);
xxx_k←8;
jj←read_ascii(p);
pen_size←pixel_round(jj*65536.0);
if pen_size>20 then pen_size←20 else if pen_size<0 then pen_size←0;
im_byte(set_pen); im_byte(pen_size);
im_byte(circ_arc);
@!debug
gubed
print('(',pen_size:1,')');
jj←read_ascii(p);
r←pixel_round(jj); im_halfword(r); {the radius}
jj←read_ascii(p);
q←round(jj*16384/360);
im_halfword(q); {first angle}
@!debug
gubed
print('(',q:1,')');
jj←read_ascii(p);
r←round(jj*16384/360);
if r=q then r←q+16383;{Imagen requires this to draw a complete circle}
im_halfword(r); {second angle}
@!debug
gubed
print('(',r:1,')');
im_byte(draw_path); im_byte(15);
end;
end;
end;
@#
procedure do_ellipse(p:integer);
var k,q,r:integer; jj,kk:real;
negative:boolean; {is it a negative number?}
match:boolean; {does everything match}
begin if p<18 then for k←2 to p do xxx_o←get_byte else
begin match←true;
for k←2 to 8 do
begin xxx_o←get_byte;
if xxx_o≠xxx_circle[k] then match←false;
@!debug
gubed
print(xchr[xxx_o]);
end;
if not match then for k←9 to p do xxx_o←get_byte else
begin xxx_o←get_byte;
@!debug
gubed
print(xchr[xxx_o]);
xxx_k←9;
jj←read_ascii(p);
pen_size←pixel_round(jj*65536.0);
if pen_size>20 then pen_size←20 else if pen_size<0 then pen_size←0;
im_byte(set_pen); im_byte(pen_size);
im_byte(circ_arc);
@!debug
gubed
print('(',pen_size:1,')');
jj←read_ascii(p);
r←pixel_round(jj); im_halfword(r); {radiusa, originally on h axis}
jj←read_ascii(p);
r←pixel_round(jj); im_halfword(r); {radiusb, originally on v axis}
jj←read_ascii(p);
q←round(jj*16384/360);
im_halfword(q); {alpha_offset, rotation of radiusa and radiusb}
jj←read_ascii(p);
q←round(jj*16384/360);
im_halfword(q); {first angle}
@!debug
gubed
print('(',q:1,')');
jj←read_ascii(p);
r←round(jj*16384/360);
if r=q then r←q+16383;{Imagen requires this to draw a complete circle}
im_halfword(r); {second angle}
@!debug
gubed
print('(',r:1,')');
im_byte(draw_path); im_byte(15);
end;
end;
end;